home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Moof
/
Goodies
/
HyperCard Goodies
/
Serial Toolkit
/
Source Code
/
XModem.p
< prev
Wrap
Text File
|
1988-11-18
|
13KB
|
521 lines
(*
XModem command,folderName,fileName -- Send or receive a file using the XModem protocol. If
command is "receive", then receive a file and name it as specified. If the command is "send",
then send the named file. The folder and file name are separate so that the file can be downloaded
into the right folder before knowing the proper name. Assume the serial port has already been opened.
This XModem implementation handles normal XModem and CRC XModem. It does not know anything
about the format of the data being sent or received -- i.e., it doesn't know anything about MacBinary.
It sends very fast. Receive could be sped up some (it should compute the CRC as it's receiving, not
afterward), but it isn't all that bad either.
To compile and link this file using Macintosh Programmer's Workshop,
pascal -w XModem.p
link -m ENTRYPOINT -o HyperCommands -rt XCMD=7036 -sn Main=XModem ∂
XModem.p.o "{MPW}"Libraries:interface.o "{MPW}"PLibraries:PasLib.o
© Copyright 1987,88 by Apple Computer, Inc.
Initial coding 9/87 by Harry R. Chesley.
*)
{$R-}
{$S XModem } { Segment name must be the same as the command name. }
unit DummyUnit;
interface
uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
procedure EntryPoint(paramPtr: XCmdPtr);
implementation
type
Str31 = String[31];
procedure XModem(paramPtr: XCmdPtr); forward;
procedure EntryPoint(paramPtr: XCmdPtr);
begin
XModem(paramPtr);
end;
{«XModem(paramPtr: XCmdPtr)»}
procedure XModem(paramPtr: XCmdPtr);
const TEMPFILENAME = '*** recvXModemTemp ***';
RETRY = 5;
RECSIZE = 128;
EOT = 4;
CRC = ord('C');
ACK = 6;
NAK = $15;
CAN = $18;
SOH = 1;
var theFolder: str255;
theFile: Str255;
tempFile: str255;
cmd: Str255; { The command. }
dummy: OSErr;
fileRef: integer; { Input or output file reference number. }
useCRC: boolean; { True if we're using CRCs. }
crcAccum, checkSum: longInt; { The CRC or checksum. }
buffer: array [1..RECSIZE] of SignedByte; { The I/O buffer. }
recNum: longInt; { The current record number. }
{$I XCmdGlue.inc}
procedure Fail(errMsg: Str255);
{ Set theResult and quit. }
begin
paramPtr^.returnValue := PasToZero(errMsg);
exit(XModem);
end;
{$I SPortUtil.inc}
{«Miscellaneous Routines» Miscellaneous Routines }
function byteAvailable: boolean;
{ Returns true if a serial port input byte is available. }
var l: longInt;
begin
if SerGetBuf(ThisSPort.portInDev,l) <> noErr then Fail('SerGetBuf failed');
byteAvailable := l > 0;
end;
function readOne: SignedByte;
{ Reads a byte from the serial port. }
var l: longInt;
theByte: SignedByte;
begin
l := 1;
if FSRead(ThisSPort.portInDev,l,@theByte) <> noErr then Fail('FSRead failed');
readOne := theByte;
end;
procedure tx(b: SignedByte);
{ Transmits a byte to to serial port. }
var theByte: SignedByte;
l: longInt;
begin
theByte := b;
l := 1;
if FSWrite(ThisSPort.portOutDev,l,@theByte) <> noErr then Fail('FSWrite failed');
end;
function swait: SignedByte;
{ Waits up to 2 seconds for a byte from the serial port. }
var stoppingTime: longInt;
theByte: SignedByte;
l: longInt;
begin
stoppingTime := TickCount + 120;
while TickCount < stoppingTime do
if byteAvailable then
begin
swait := readOne;
exit(swait);
end;
swait := 0;
end;
procedure clearInput;
{ Clear out any residual characters on the input port. }
var theByte: SignedByte;
begin
while byteAvailable do theByte := readOne;
end;
procedure sleep(ticks: longInt);
{ Wait for ticks 1/60ths of a second. }
var finalTime: longInt;
begin
finalTime := TickCount + ticks;
repeat until TickCount >= finalTime;
end;
{«CRC/Checksum Routines» CRC/Checksum Routines }
procedure clrCrc;
{ Clear out the CRC/checksum. }
begin
crcAccum := 0;
checkSum := 0;
end;
procedure updCrc(b: SignedByte);
{ Process one more byte into the CRC/Checksum. }
var i: integer;
flag: longInt;
begin
if useCRC then
begin
for i := 7 downto 0 do
begin
flag := BitAnd(crcAccum,$08000);
crcAccum := BitShift(crcAccum,1);
if BitAnd(BitShift(1,i),b) <> 0 then crcAccum := BitOr(crcAccum,1);
if flag <> 0 then crcAccum := BitXor(crcAccum,$01021);
end;
end
else checkSum := checkSum + BitAnd(b,$FF);
end;
{«sendFile»}
procedure sendFile;
{ Open and send a file. }
var didSend: boolean; { True if send was successfull. }
function send: boolean;
{ Send the file (once it's been opened). }
var i: integer;
procedure Fail(errMsg: Str255);
{ Set theResult and quit. }
var dummy: OSErr;
begin
dummy := FSClose(fileRef);
paramPtr^.returnValue := PasToZero(errMsg);
exit(XModem);
end;
function waitCan(t: longInt): SignedByte;
{ Wait up to t ticks for a byte from the serial port. }
var stopTime: longInt;
theByte: SignedByte;
begin
stopTime := TickCount+t;
while TickCount < stopTime do
if byteAvailable then
begin
theByte := readOne;
if theByte = CAN then exit(send);
waitCan := theByte;
exit(waitCan);
end;
waitCan := 0;
end;
procedure synch;
{ Synchronize our ACKs/NAKs and figure out if we're doing CRCs or checksums. }
var i: integer;
theByte: SignedByte;
begin
clearInput;
{ Try up to ten times to synchronize. }
for i := 1 to 10 do
begin
{ Get a character. }
theByte := waitCan(600);
{ Check for NAK — normal, checksum XModem. }
if theByte = NAK then
begin
useCRC := false;
exit(synch);
end;
{ Check for CRC — CRC style XModem. }
if theByte = CRC then
begin
useCRC := true;
exit(synch);
end;
end;
{ Didn't find it. Give up. }
Fail('could not synchronize');
end;
function fillBuf: boolean;
{ Get a bufferfull from disk. }
var l: longInt;
begin
l := RECSIZE;
if (FSRead(fileRef,l,@buffer) <> noErr) or (l = 0) then fillBuf := false
else fillBuf := true;
end;
procedure txRec;
{ Transmit one record. }
var i, j: integer;
theByte: SignedByte;
begin
clearInput;
{ Try to send the record up to 25 times. }
for i := 1 to 25 do
begin
{ Send the record header. }
tx(SOH);
tx(BitAnd(recNum,$FF));
tx(BitAnd(BitXor(recNum,$FF),$FF));
{ Send the record body, figuring the CRC as we go. }
clrCrc;
for j := 1 to RECSIZE do
begin
tx(buffer[j]);
updCrc(buffer[j]);
end;
updCrc(0); updCrc(0);
{ Send the CRC. }
if useCrc then
begin
tx(BitAnd(BitShift(crcAccum,-8),$FF));
tx(BitAnd(crcAccum,$FF));
end
else tx(BitAnd(checkSum,$FF));
{ Wait for the ACK. }
if waitCan(600) = ACK then
begin
{ If we succeeded, increment the record number. }
recNum := recNum+1;
exit(txRec);
end;
end;
Fail('retries exceeded')
end;
begin
{ Initialize and synchronize with the other side. }
send := false;
recNum := 1;
synch;
{ Send the file, one record at a time. }
while fillBuf do txRec;
{ Make sure he knows we're all done. }
for i := 1 to 100 do
begin
tx(EOT);
if waitCan(60) = ACK then leave;
end;
send := true;
end;
begin
{ Open the file to be sent. }
if FSOpen(theFile,0,fileRef) <> noErr then Fail('no such file');
{ Send the file. }
didSend := send;
{ Close the file. }
if FSClose(fileRef) <> noErr then Fail('FSClose failed');
if not didSend then Fail('send aborted');
end;
{«receiveFile»}
procedure receiveFile;
{ Create and receive one file. }
var didReceive: boolean; { True if the receive was successfull. }
i: integer;
lastColon: integer;
volName: str255;
function receive: boolean;
{ Receive the file (once it has been created on disk). }
var i: integer;
theByte: SignedByte;
response: SignedByte;
r1, r2: longInt;
crcHi, crcLo: longInt;
l: longInt;
procedure Fail(errMsg: Str255);
{ Set theResult and quit. }
var dummy: OSErr;
begin
dummy := FSClose(fileRef);
paramPtr^.returnValue := PasToZero(errMsg);
exit(XModem);
end;
begin
{ Assume we'll fail: }
receive := false;
{ Dump any previous residue: }
clearInput;
{ Assume we're doing CRC XModem: }
response := CRC;
useCRC := true;
{ Start at record one: }
recNum := 1;
{ Read in the file: }
while true do
begin
{ Synch up: }
clearInput;
for i := 1 to 10*RETRY do
begin
{ Let him know what happened last time (or NAK him the first time). }
tx(response);
{ Get a byte. }
theByte := swait;
{ Check or start-of-record. }
if theByte = SOH then leave;
{ Check for end-of-file. }
if theByte = EOT then
begin
tx(ACK);
receive := true;
exit(receive);
end;
{ Check for manual cancel. }
if theByte = CAN then exit(receive);
{ If we've tried CRCs for a while, try checksums now. }
if i = 5*RETRY then
begin
if response = CRC then
begin
response := NAK;
useCRC := false;
end
else leave;
end;
end;
{ If this isn't another block, it must be that we've run out of retries. }
if theByte <> SOH then exit(receive);
{ Receive the record number (and its complement). }
r1 := BitAnd(swait,$FF); r2 := BitAnd(swait,$FF);
{ Receive the record. }
for i := 1 to RECSIZE do buffer[i] := swait;
{ Receive the CRC/checksum. }
if useCRC then crcHi := BitAnd(swait,$FF);
crcLo := BitAnd(swait,$FF);
{ Assume this one'll be bad. }
response := NAK;
{ Check for bad record number. }
if BitAnd(BitNot(r1),$FF) <> r2 then cycle;
{ Check for bad CRC/checksum. }
clrCrc;
for i := 1 to RECSIZE do updCrc(buffer[i]);
updCrc(0); updCrc(0);
if useCRC then
begin
if (crcLo + BitShift(crcHi,8)) <> BitAnd(crcAccum,$0FFFF) then
begin
{ Give things time to settle out. }
sleep(120);
cycle;
end;
end
else if crcLo <> BitAnd(checkSum,$FF) then
begin
{ Give things time to settle out. }
sleep(120);
cycle;
end;
{ Check if this is a record we've already received. }
if r1 = BitAnd(recNum-1,$FF) then
begin
{ If it is... }
response := ACK;
cycle;
end;
{ Check if this record is WAY out of sequence. }
if r1 <> BitAnd(recNum,$FF) then Fail('fatal record sequencing error');
{ Increment our expected record number. }
recNum := recNum+1;
{ Write the record to disk. }
l := RECSIZE;
if FSWrite(fileRef,l,@buffer) <> noErr then Fail('FSWrite failed');
response := ACK;
end;
end;
begin
{ Create the temporary input file (will be renamed later to the real name if we make it OK). }
dummy := FSDelete(tempFile,0);
if Create(tempFile,0,'????','????') <> noErr then Fail('could not create temp file');
if FSOpen(tempFile,0,fileRef) <> noErr then Fail('FSOpen failed on temp file');
{ Receive the file: }
didReceive := receive;
{ Close the file, and rename the temporary file to the permanent name. }
if FSClose(fileRef) <> noErr then Fail('FSClose failed');
if didReceive then
begin
dummy := FSDelete(theFile,0);
if Rename(tempFile,0,theFile) <> noErr then Fail('Rename failed');
end
else
begin
if FSDelete(tempFile,0) <> noErr then Fail('FSDelete failed');
Fail('receive aborted');
end;
lastColon := 0;
for i := 1 to length(theFile) do
if theFile[i] = ':' then lastColon := i;
if lastColon = 0 then volName := ''
else volName := Copy(theFile,1,lastColon);
if FlushVol(@volName,0) <> noErr then Fail('FlushVol failed');
end;
{«Main Program» Main Program }
begin
{ Check the parameter count. }
if paramPtr^.paramCount <> 3 then Fail('parameter count is not 3');
{ Get the parameters. }
GetStrParm(1,cmd); { First parameter is the command. }
GetStrParm(2,theFolder); { Second parameter is the folder to put the file in. }
tempFile := Concat(theFolder,TEMPFILENAME);
GetStrParm(3,theFile); { Third parameter is file name to send/receive. }
theFile := Concat(theFolder,theFile);
SetUpSPortGlobals;
EnsureOpenPort;
{ Find out what command we're doing and do it. }
if StringEqual(cmd,'send') then sendFile
else if StringEqual(cmd,'receive') then receiveFile
else Fail('invalid command');
end;
end.